home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 037a / exemenu.zip / EXEMENU.PAS < prev   
Pascal/Delphi Source File  |  1991-04-09  |  25KB  |  665 lines
  1. program exemenu;                                                 { version 2.2 }
  2.  
  3.  
  4.  
  5. (******************************************************** 1991 J.C. Kessels ****
  6.  
  7. This is freeware. No guarantees whatsoever. You may change it, use it,
  8. copy it, anything you like.
  9.  
  10.  
  11. J.C. Kessels
  12. Philips de Goedelaan 7
  13. 5615 PN  Eindhoven
  14. Netherlands
  15. ******************************************************************************)
  16.  
  17.  
  18. {$M 3000,0,0}                               { No heap, or we can't use 'exec'. }
  19.  
  20.  
  21. uses dos;
  22.  
  23.  
  24.  
  25.  
  26. const
  27. (* English version: *)
  28.   StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';         { Name of program. }
  29.   StrBusy      = 'Busy....';                        { Program is busy message. }
  30.   StrHelp      = 'Enter=Start  ESC=Stop';          { Bottom-left help message. }
  31.   StrStart     = 'Busy starting program: ';         { Start a program message. }
  32.   { Wrong DOS version message. }
  33.   StrDos       = 'Sorry, this program only works with DOS versions 3.xx and above.';
  34.   { Unrecognised error message. }
  35.   StrError     = 'EXEMENU: unrecognised error caused program termination.';
  36.   StrExit      = 'That''s it, folks!';                         { Exit message. }
  37. (* Dutch version: *)
  38. (*
  39.   StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';  { Naam van het programma. }
  40.   StrHelp      = 'Enter=Start  ESC=Stop';        { Bodem-links hulp boodschap. }
  41.   StrBusy      = 'Bezig....';                        { Ik ben bezig boodschap. }
  42.   { Bij het starten van een programma. }
  43.   StrStart     = 'Bezig met starten van: ';
  44.   { Foutboodschap als de DOS versie niet goed is. }
  45.   StrDos       = 'Sorry, dit programma werkt slechts met DOS versie 3.xx en hoger.';
  46.   { Onbekende fout boodschap. }
  47.   StrError     = 'EXEMENU: door onbekende fout voortijdig beëindigd.';
  48.   StrExit      = 'Exemenu is geëindigd.';            { Stop EXEMENU boodschap. }
  49. *)
  50.  
  51.   DirMax = 1000;                       { Number of entries in directory array. }
  52.  
  53.  
  54.  
  55.  
  56. type
  57.   Str90 = string[90];               { We don't need anything longer than this. }
  58.  
  59.  
  60.  
  61. var
  62.   VidStore : array[0..3999] of char;                   { Video screen storage. }
  63.   Dir : array[1..DirMax] of record  { The directory is loaded into this array. }
  64.     attr : byte;                                      { 1: directory, 2: file. }
  65.     name : NameStr;                                  { Name of file/directory. }
  66.     ext  : ExtStr;                                        { Extension of file. }
  67.     end;
  68.   DirTop  : word;                            { Last active entry in Dir array. }
  69.   DirHere : word;                            { Current selection in Dir array. }
  70.   DirPath   : pathstr;                     { The path of the Loaded directory. }
  71.   OldPath   : PathStr;          { The current directory at startup of EXEMENU. }
  72.   BasicPath : PathStr;                    { The path to the basic interpreter. }
  73.   OldCursor : word;                                      { Saved cursor shape. }
  74.   xy     : word;                                       { Cursor on the screen. }
  75.   colour : byte;                                      { Colour for the screen. }
  76.   vidseg : word;                                  { Segment of the screen RAM. }
  77.   regs   : registers;                            { Registers to call the BIOS. }
  78.   Inkey  : word;                                       { The last pressed key. }
  79.   keyflags : byte absolute $0040:$0017;                 { BIOS keyboard flags. }
  80.   ExitSave : pointer;                             { Address of exit procedure. }
  81.   ExitMsg  : Str90;                         { Message to display when exiting. }
  82.   DTA  : SearchRec;                               { FindFirst-FindNext buffer. }
  83.                
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90. function Left(s : Str90; width : byte) : Str90;
  91. { Return Width characters from input string. Add trailing spaces if necessary.
  92.   }
  93. begin
  94. if width > length(s) then Fillchar(s[length(s)+1],width-length(s),32);
  95. s[0] := chr(width);
  96. Left := s;
  97. end;
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104. procedure FixupDir;
  105. { Fixup the DirPath string. }
  106. var
  107.   drive : char;
  108.   i, j : word;
  109. begin
  110. i := pos(':',DirPath);                        { Strip the drive from the path. }
  111. if i = 0 then
  112.   begin
  113.   if (length(Dirpath) > 0) and (Dirpath[1] = '\')
  114.     then DirPath := copy(OldPath,1,2) + DirPath
  115.     else if OldPath[length(OldPath)] = '\'
  116.       then DirPath := OldPath + DirPath
  117.       else DirPath := OldPath + '\' + DirPath;
  118.   i := pos(':',DirPath);               
  119.   end;
  120. drive := DirPath[1];
  121. delete(DirPath,1,i);
  122.  
  123. while pos('..',DirPath) <> 0 do                         { Remove embedded ".." }
  124.   begin
  125.   i := pos('..',DirPath);
  126.   j := i + 2;
  127.   if i > 1 then dec(i);
  128.   if (i > 1) and (DirPath[i] = '\') then dec(i);
  129.   while (i > 1) and (DirPath[i] <> '\') do dec(i);
  130.   delete(DirPath,i,j-i);
  131.   end;
  132.  
  133. { Remove embedded ".\" }
  134. while pos('.\',DirPath) <> 0 do delete(DirPath,pos('.\',DirPath),2);
  135.  
  136. if pos('\',DirPath) = 0                             { If no subdirectories.... }
  137.   then DirPath := '\'
  138.   else
  139.     begin                              { Else strip filename from the path.... }
  140.     i := pos('.',DirPath);
  141.     if i > 0 then
  142.       begin
  143.       while (i > 0) and (DirPath[i] <> '\') do dec(i);
  144.       if i > 0
  145.         then DirPath := copy(DirPath,1,i)
  146.         else DirPath := '\';
  147.       end;
  148.     if DirPath[length(DirPath)] <> '\'          { maybe add '\' at the end.... }
  149.       then DirPath := DirPath + '\';
  150.     end;
  151.  
  152. DirPath := drive + ':' + DirPath;       { Add the drive back to the directory. }
  153.  
  154. { Translate the Dirpath into all uppercase. }
  155. for i := 1 to length(DirPath) do DirPath[i] := upcase(DirPath[i]);
  156. end;
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163. procedure Show(s : Str90);               
  164. { Display string "s" at "xy", using "colour". This routine uses DMA into the
  165.   video memory. }
  166. begin
  167. Inline(
  168.   $8E/$06/>VIDSEG/       {mov  es,[>vidseg]   ; Fetch video segment in ES.}
  169.   $8B/$3E/>XY/           {mov  di,[>xy]       ; Fetch video offset in DI.}
  170.   $8A/$26/>COLOUR/       {mov  ah,[>colour]   ; Fetch video colour in AH.}
  171.   $1E/                   {push ds             ; Setup DS to stack segment.}
  172.   $8C/$D1/               {mov  cx,ss}
  173.   $8E/$D9/               {mov  ds,cx}
  174.   $8A/$8E/>S/            {mov  cl,[bp+>s]     ; Fetch string size in CX.}
  175.   $30/$ED/               {xor  ch,ch}
  176.   $8D/$B6/>S+1/          {lea  si,[bp+>s+1]   ; Fetch string address in SI.}
  177.   $E3/$04/               {jcxz l2             ; Skip if zero length.}
  178.                          {l1:}
  179.   $AC/                   {lodsb               ; Fetch character from string.}
  180.   $AB/                   {stosw               ; Show character.}
  181.   $E2/$FC/               {loop l1             ; Next character.}
  182.                          {l2:}
  183.   $1F/                   {pop  ds             ; Restore DS.}
  184.   $89/$3E/>XY);          {mov  [>xy],di       ; Store new XY.}
  185. end;
  186.  
  187.  
  188.  
  189.  
  190. procedure ShowMenu(Message : Str90);
  191. { Display the screen, with borders, a "Message" in line 2, and the loaded
  192.   directory in the rest of the screen. }
  193. var
  194.   i   : word;                                                 { Work variable. }
  195.   s   : Str90;                                                { Work variable. }
  196.   pagetop : word;                          { Top of the page in the Dir array. }
  197.   row     : word;                          { The display row we are busy with. }
  198. begin
  199. xy := 0;                                                         { First line. }
  200. colour := $13;
  201. if length(StrCopyright) > 76
  202.   then i := 76
  203.   else i := length(StrCopyright);
  204. s[0] := chr((76 - i) div 2);
  205. Fillchar(s[1],ord(s[0]),'═');
  206. Show('╔'+s+'╡');
  207. colour := $1B;
  208. Show(copy(StrCopyright,1,i));
  209. colour := $13;
  210. s[0] := chr(76 - length(s) - length(StrCopyright));
  211. Fillchar(s[1],ord(s[0]),'═');
  212. Show('╞'+s+'╗║ ');
  213.  
  214. colour := $1E;                                                  { Second line. }
  215. Show(left(Message,76));
  216.  
  217. colour := $13;                                                   { Third line. }
  218. Show(' ║╟──────────────────────────────────────────────────────────────────────────────╢');
  219.  
  220. { Display all the directory entries, using the current cursor position
  221.   to calculate the top-left of the page. }
  222. pagetop := DirHere - DirHere mod 105 + 1;
  223. for i := pagetop to pagetop + 20 do
  224.   begin
  225.   colour := $13;
  226.   Show('║ ');
  227.   colour := $1E;
  228.   row := 0;
  229.   while row <= 84 do
  230.     begin
  231.     if i+row <= DirTop
  232.       then if Dir[i+row].attr = 1
  233.         then Show(left(Dir[i+row].name,14))
  234.         else Show(left(Dir[i+row].name,8) + '.' + left(Dir[i+row].ext,5))
  235.       else Show('              ');
  236.     row := row + 21;
  237.     end;
  238.   colour := $13;
  239.   Show('       ║');
  240.   end;
  241.  
  242. colour := $13;                                                    { Last line. }
  243. Show('╚══╡');
  244. colour := $1B;
  245. if length(StrHelp) > 74
  246.   then i := 74
  247.   else i := length(StrHelp);
  248. Show(copy(StrHelp,1,i));
  249. colour := $13;
  250. s[0] := chr(74-i);
  251. Fillchar(s[1],ord(s[0]),'═');
  252. Show('╞'+s+'╝');
  253. end;
  254.  
  255.  
  256.  
  257.  
  258. procedure ShowBar(here : word; onoff : boolean);
  259. { Display (onoff = true) or remove (onoff = false) the cursor bar at the screen
  260.   location that shows the "here" entry in the Dir array. Every entry has a
  261.   fixed location on the screen. }
  262. var
  263.   i : word;
  264. begin
  265. i := Here mod 105 - 1;                         { Calculate position on screen. }
  266. xy := 484 + (i div 21) * 28 + (i mod 21) * 160;
  267. if onoff                                            { Setup the proper colour. }
  268.   then colour := $70
  269.   else colour := $1E;
  270. if Here <= DirTop                                     { Display the Dir entry. }
  271.   then if Dir[Here].attr = 1
  272.     then Show(left(Dir[Here].name,12))            { Directories without a dot. }
  273.     else Show(left(Dir[Here].name,8) + '.' + left(Dir[Here].ext,3))
  274.   else Show('            ');                                  { Empty entries. }
  275. colour := $1E;                                             { Reset the colour. }
  276. end;
  277.  
  278.  
  279.  
  280.  
  281. procedure InitVideo;
  282. { Initialise the video. If not 80x25 then switch to it. Store the screen.
  283.   Hide the cursor. }
  284. var
  285.   i : byte;
  286. begin
  287. regs.ah := $0F;                  { If not text mode 3 or 7, then switch to it. }
  288. intr($10,regs);
  289. i := regs.al and $7F;
  290. regs.ah := $03;                { Save current cursor shape. BH is active page. }
  291. intr($10,regs);
  292. OldCursor := regs.cx;
  293. if (i <> 3) and (i <> 7) then               
  294.   begin
  295.   regs.al := 3;
  296.   regs.ah := 0;
  297.   intr($10,regs);
  298.   i := 3;
  299.   end;
  300.  
  301. if i <> 7                                             { Compute video segment. }
  302.   then vidseg := $B800 + (memw[$0040:$004E] shr 4)
  303.   else vidseg := $B000 + (memw[$0040:$004E] shr 4);
  304.  
  305. move(mem[vidseg:0],VidStore[0],4000);                  { Store current screen. }
  306.  
  307. regs.cx := $2000;                                               { Hide cursor. }
  308. regs.ah := 1;
  309. intr($10,regs);
  310.  
  311. colour := $1E;                                              { Reset attribute. }
  312. xy := 0;                                                       { Reset cursor. }
  313. end;
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320. procedure ResetVideo;
  321. { Reset the video back to it's original contents. Show the cursor. }
  322. begin
  323. move(VidStore[0],mem[vidseg:0],4000);                        { Restore screen. }
  324.  
  325. regs.cx := OldCursor;                           { Reset original cursor chape. }
  326. regs.ah := 1;
  327. intr($10,regs);
  328. end;
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335. {$F+}
  336. procedure ExitCode;
  337. { Reset display upon exit. This also works for error exit's. }
  338. begin
  339. ResetVideo;                             { Reset the original display contents. }
  340. if ExitMsg <> '' then writeln(ExitMsg);                   { Show exit message. }
  341. ChDir(OldPath);                                        { Restore current path. }
  342. ExitProc := ExitSave;                         { Reset previous exit procedure. }               
  343. end;
  344. {$F-}
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351. procedure LoadDir;
  352. { Load the "DirPath" directory into memory. }
  353. var
  354.   i    : word;                                                { Work variable. }
  355.   s    : pathstr;                                             { Work variable. }
  356.   name : NameStr;                                      { Name of current file. }
  357.   ext  : ExtStr;                                  { Extension of current file. }
  358.   attr : byte;                                    { Attribute of current file. }
  359. begin
  360. colour := $1E;                                          { Show "busy" message. }
  361. xy := 164;
  362. Show(left(StrBusy,76));
  363.  
  364. FixupDir;                                        { Cleanup the DirPath string. }
  365. DirTop := 0;                              { Reset pointers into the Dir array. }
  366. DirHere := 1;
  367.  
  368. FindFirst(DirPath+'*.*',AnyFile,DTA);                       { Find first file. }
  369. while (DosError = 3) and (length(DirPath) > 3) do       { If path not found....}
  370.   begin
  371.   i := length(DirPath);                 { then strip last directory from path. }
  372.   if i > 3 then dec(i);
  373.   while (i > 3) and (DirPath[i] <> '\') do dec(i);
  374.   DirPath := copy(DirPath,1,i);
  375.   FindFirst(DirPath+'*.*',AnyFile,DTA);                       { And try again. }
  376.   end;
  377.  
  378. while DosError = 0 do                                     { For all the files. }
  379.   begin
  380.   attr := 0;
  381.   if (DTA.attr and Directory) = Directory
  382.     then
  383.       begin                                           { Setup for directories. }
  384.       name := DTA.name;
  385.       ext := '';
  386.       if DTA.name <> '.' then attr := 1;               { Ignore '.' directory. }
  387.       if DTA.name = '..' then name := '..';
  388.       end
  389.     else
  390.       begin
  391.       for i := 1 to length(DTA.name) do     { Translate filename to lowercase. }
  392.         if DTA.name[i] IN ['A'..'Z'] then
  393.           DTA.name[i] := chr(ord(DTA.name[i])+32);
  394.       i := pos('.',DTA.name);          { Split filename in name and extension. }
  395.       if i > 0
  396.         then
  397.           begin
  398.           name := copy(DTA.name,1,i-1);
  399.           ext  := copy(DTA.name,i+1,length(DTA.name)-i);
  400.           end
  401.         else
  402.           begin
  403.           name := DTA.name;
  404.           ext := '';
  405.           end;
  406.       { Ignore unrecognised extensions. }
  407.       if (ext = 'com') and (DTA.name <> 'command.com') then attr := 2;
  408.       if (ext = 'exe') and (DTA.name <> 'exemenu.exe') then attr := 2;
  409.       if (ext = 'bat') and (DTA.name <> 'autoexec.bat') then attr := 2;
  410.       if (ext = 'bas') and (BasicPath <> '') then attr := 2;
  411.       end;
  412.   { If recognised extension or directory, then load into memory. }
  413.   if attr > 0 then
  414.     begin
  415.     i := 1;
  416.     while (i <= DirTop) and            { Find location where to insert (sort). }
  417.       ((attr > Dir[i].attr) or
  418.       ((attr = Dir[i].attr) and (name > Dir[i].name)) or
  419.       ((attr = Dir[i].attr) and (name = Dir[i].name) and (ext > Dir[i].ext)))
  420.       do inc(i);
  421.     if DirTop < DirMax then inc(DirTop);
  422.     if i < DirTop then                     { Move entries up, to create entry. }
  423.       move(Dir[i],Dir[i+1],sizeof(Dir[1]) * (DirTop - i));
  424.     if i <= DirMax then                                      { Fill the entry. }
  425.       begin
  426.       Dir[i].name := name;
  427.       Dir[i].ext  := ext;
  428.       Dir[i].attr := attr;
  429.       end;
  430.     end;
  431.   FindNext(DTA);                                                  { Next item. }
  432.   end;
  433.  
  434. { Analyse the results. If nothing found (maybe disk error), and if we are in a
  435.   subdirectory, then at least add the parent directory. }
  436. if (DirTop = 0) and (length(DirPath) > 3) then
  437.   begin
  438.   Dir[1].name := '..';
  439.   Dir[1].ext  := '';
  440.   Dir[1].attr := 1;
  441.   DirTop      := 1;
  442.   end;
  443.  
  444. end;
  445.  
  446.  
  447.  
  448.  
  449.  
  450.  
  451. procedure ExecuteProgram;
  452. { Execute the program at "DirHere". }
  453. var
  454.   ProgramPath : pathstr;                     { Path to the program to execute. }
  455. begin
  456. { Return from this subroutine if there is no program at the cursor. }
  457. if (DirHere < 1) or (DirHere > DirTop) or (Dir[DirHere].attr <> 2) then exit;
  458.  
  459. colour := $1E;                                          { Show "busy" message. }
  460. xy := 164;
  461. Show(left(StrBusy,76));
  462.  
  463. { Setup path to the program. }
  464. ProgramPath := DirPath + Dir[DirHere].name + '.' + Dir[DirHere].ext;
  465.  
  466. FindFirst(ProgramPath,AnyFile,DTA);  { Test if the path to the program exists. }
  467. if DosError <> 0 then exit;                                   { Exit if error. }
  468.  
  469. ResetVideo;                                          { Reset the video screen. }
  470. writeln(StrStart,ProgramPath);                         { Show startup message. }
  471.  
  472. ChDir(copy(DirPath,1,length(DirPath)-1));           { Change to the directory. }
  473. SwapVectors;                                                  { Start program. }
  474. if Dir[DirHere].ext = 'bat'               { .BAT files trough the COMMAND.COM. }
  475.   then Exec(getenv('COMSPEC'),'/C '+ProgramPath)
  476.   else if Dir[DirHere].ext = 'bas'        { .BAS trough the basic interpreter. }
  477.     then Exec(BasicPath,ProgramPath)
  478.     else Exec(ProgramPath,'');                              { Others directly. }
  479. SwapVectors;
  480.  
  481. InitVideo;                                             { Initialise the video. }
  482. ShowMenu(StrBusy);                          { Draw screen with "busy" message. }
  483.  
  484. { Reset keyboard flags. }
  485. keyflags := keyflags and $0F;  { Capslock, Numlock, ScrollLock and Insert off. }
  486. fillchar(regs,sizeof(regs),#0);                             { Clear registers. }
  487. regs.ah := 1;                                          { Activate new setting. }
  488. intr($16,regs);
  489.  
  490. regs.ah := 1;                                     { Clear the keyboard buffer. }
  491. intr($16,regs);
  492. while (regs.flags and fzero) = 0 do
  493.   begin
  494.   regs.ah := 0;
  495.   intr($16,regs);
  496.   regs.ah := 1;
  497.   intr($16,regs);
  498.   end;
  499.  
  500. Inkey := 13;
  501. end;
  502.  
  503.  
  504.  
  505.  
  506.  
  507.  
  508. var
  509.   i : word;                                                    { Workvariable. }
  510.   s : Str90;                                                   { Workvariable. }
  511.   OldHere, OldPageTop : word;                 { Determine if cursor has moved. }
  512.  
  513.  
  514.  
  515. begin
  516. DirPath := '';                                { No directory loaded right now. }
  517. DirTop := 0;                                  { No directory loaded right now. }
  518. ExitMsg := StrError;                                    { Reset error message. }
  519. getdir(0,OldPath);                                   { Save current directory. }
  520. ExitSave := ExitProc;                                  { Setup exit procedure. }
  521. ExitProc := @ExitCode;
  522. InitVideo;                                             { Initialise the video. }
  523. ShowMenu(StrBusy);                          { Draw screen with "busy" message. }
  524.  
  525. if lo(DosVersion) < 3 then                                 { Test DOS version. }
  526.   begin
  527.   ExitMsg := StrDos;
  528.   halt(1);
  529.   end;
  530.  
  531. { Determine what directory to search for programs. Default is the current
  532.   directory. Otherwise the first argument after EXEMENU is used as starting
  533.   path. }
  534. if paramcount = 0
  535.   then DirPath := OldPath
  536.   else DirPath := paramstr(1);
  537.  
  538. { Find the basic interpreter somewhere in the path. If not found, then basic
  539.   programs will not be listed. }
  540. BasicPath := Fsearch('GWBASIC.EXE',GetEnv('PATH'));
  541. if BasicPath = '' then BasicPath := Fsearch('GWBASIC.COM',GetEnv('PATH'));
  542. if BasicPath = '' then BasicPath := Fsearch('BASIC.EXE',GetEnv('PATH'));
  543. if BasicPath = '' then BasicPath := Fsearch('BASIC.COM',GetEnv('PATH'));
  544. if BasicPath = '' then BasicPath := Fsearch('BASICA.EXE',GetEnv('PATH'));
  545. if BasicPath = '' then BasicPath := Fsearch('BASICA.COM',GetEnv('PATH'));
  546. if BasicPath <> '' then BasicPath := FExpand(BasicPath);
  547.  
  548. LoadDir;                                     { Load the directory into memory. }
  549. ShowMenu(DirPath);                                    { Display the directory. }
  550. ShowBar(DirHere,true);                         { Highlight the current choice. }
  551.  
  552. { The main loop, exited only when the user presses ESC. }
  553. repeat
  554.   { Wait for a key to be pressed. Place the scancode in the Inkey variable. }
  555.   regs.ah := 0;
  556.   intr($16,regs);
  557.   Inkey := regs.ax;
  558.  
  559.   if lo(Inkey) = 13 then                                  { Process ENTER key. }
  560.     begin
  561.     ShowBar(DirHere,false);                               { Remove cursor bar. }
  562.     s := '';                                                 { No item stored. }
  563.     { If cursor points to a program....}
  564.     if DirHere <= DirTop then if Dir[DirHere].attr = 2
  565.       then
  566.         begin
  567.         { Store the item to execute, so we can move the cursor back to it. }
  568.         s := Dir[DirHere].name + '.' + Dir[DirHere].ext;
  569.         ExecuteProgram;                          { Then execute the program....}
  570.         end
  571.       else if Dir[DirHere].name <> '..'           { Else goto the directory....}
  572.         then DirPath := fexpand(DirPath+Dir[DirHere].name) + '\'
  573.         else
  574.           begin                                { Or goto the parent directory. }
  575.           i := length(DirPath) - 1;
  576.           while (i >= 1) and (DirPath[i] <> '\') do dec(i);
  577.           { Store the directory we just left, so we can move the cursor to it. }
  578.           s := copy(DirPath,i+1,length(DirPath)-i-1);
  579.           if i > 0
  580.             then DirPath := copy(DirPath,1,i)
  581.             else DirPath := '\';
  582.           end;
  583.     LoadDir;                                           { Reload the directory. }
  584.     { If an item was stored, then find it, and move the cursor to it. }
  585.     if s <> '' then
  586.       begin
  587.       DirHere := 1;
  588.       if pos('.',s) = 0
  589.         then while (DirHere < DirTop) and (Dir[DirHere].name <> s) do
  590.           inc(DirHere)
  591.         else while (DirHere < DirTop) and
  592.           (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s) do inc(DirHere);
  593.       if (DirHere <= DirTop) and (
  594.           ((pos('.',s) = 0) and
  595.            (Dir[DirHere].name <> s)) or
  596.           ((pos('.',s) > 0) and
  597.            (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s)) )
  598.         then DirHere := 1;
  599.       end;
  600.     ShowMenu(DirPath);                                        { Show the menu. }
  601.     ShowBar(DirHere,true);                                  { Show cursor bar. }
  602.     end;
  603.  
  604.   { Process cursor movement keys. }
  605.   OldHere := DirHere; { Remember current cursor, to determine if it has moved. }
  606.   if (Inkey = $4800) and (DirHere > 1) then dec(DirHere);          { arrow-up. }
  607.   if (Inkey = $5000) and (DirHere < DirTop) then inc(DirHere);   { arrow-down. }
  608.   if (Inkey = $4D00) or (lo(Inkey) = 9) then             { arrow-right or tab. }
  609.     if DirHere + 21 <= DirTop
  610.       then DirHere := DirHere + 21
  611.       else DirHere := DirTop;
  612.   if (Inkey = $4B00) or (Inkey = $0F00) then        { arrow-left or shift-tab. }
  613.     if DirHere > 21
  614.       then DirHere := DirHere - 21
  615.       else DirHere := 1;
  616.   if (Inkey = $5100) and (DirHere < DirTop) then                       { pgdn. }
  617.     if DirTop > 105
  618.       then if DirHere + 105 < DirTop
  619.         then DirHere := DirHere + 105
  620.         else DirHere := DirTop
  621.       else if (DirHere - 1) mod 21 = 20
  622.         then if DirHere + 21 <= DirTop
  623.           then DirHere := DirHere + 21
  624.           else DirHere := DirTop
  625.         else if DirHere - (DirHere - 1) mod 21 + 20 < DirTop
  626.           then DirHere := DirHere - (DirHere - 1) mod 21 + 20
  627.           else DirHere := DirTop;
  628.   if (Inkey = $4900) and (DirHere > 1) then                            { pgup. }
  629.     if DirTop > 105
  630.       then if DirHere > 105
  631.         then DirHere := DirHere - 105
  632.         else DirHere := 1
  633.       else if (DirHere - 1) mod 21 = 0
  634.         then if DirHere > 21
  635.           then DirHere := DirHere - 21
  636.           else DirHere := 1
  637.         else DirHere := DirHere - (DirHere - 1) mod 21;
  638.   if Inkey = $4700 then DirHere := 1;                                  { home. }
  639.   if Inkey = $4F00 then DirHere := DirTop;                              { end. }
  640.   if lo(Inkey) > 31 then                          { Process a character inkey. }
  641.     begin
  642.     i := 1;
  643.     while (i <= DirTop) and (Dir[i].name[1] <> chr(lo(Inkey))) do inc(i);
  644.     if i <= DirTop then DirHere := i;
  645.     end;
  646.   if DirHere = 0 then DirHere := 1;                  { Correct for empty list. }
  647.   { If the cursor has moved off the screen, then redraw the menu. }
  648.   if OldHere - OldHere mod 105 + 1 <> DirHere - DirHere mod 105 + 1 then
  649.     begin
  650.     ShowBar(OldHere,false);
  651.     ShowMenu(DirPath);
  652.     ShowBar(DirHere,true);
  653.     OldHere := DirHere;
  654.     end;
  655.   if OldHere <> DirHere then        { If the cursor has moved, then redraw it. }
  656.     begin
  657.     ShowBar(OldHere,false);
  658.     ShowBar(DirHere,true);
  659.     end;
  660.  
  661. until lo(Inkey) = 27;                                 { Until ESC key pressed. }
  662.  
  663. ExitMsg := StrExit;                                       { Exit with message. }
  664. end.
  665.